home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / data / happypas / mineswep.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-30  |  6KB  |  157 lines
  1. {*********************************************************************
  2.  *  *** マインスイーパー ***                                         *
  3.  *                                                                   *
  4.  *        HAPPyのサンプルプログラム                                  *
  5.  *          (作者  浅野比富美 Public Domain Software)                *
  6.  *********************************************************************}
  7.  
  8. program MineSweeper(input,output) ;
  9.  
  10. {  ８×８のマス目に１０個の地雷が仕掛けてあります。この１０個の地雷を
  11. 　 避けた５４のマスを陣地として無事取ることができればクリアというゲーム
  12. 　 です。マスを開くと、そのマスの縦横斜めに何個の地雷があるかを数字で
  13.  　表示してくれます。この数字を頼りにマスを開いていくわけですが、地雷に
  14.  　当たればそこでゲームオーバーとなります。}
  15.  
  16.   label  999          ; { 地雷に当たった時のゲームオーバー用ラベル         }
  17.  
  18.   const  N       =  8 ; { 盤の一辺のサイズ                                 }
  19.          M       =  9 ; { N+1    実際の配列は上下左右に1つずつ余分がある   }
  20.          MaxMine = 10 ; { 地雷の数                                         }
  21.  
  22.   type   TableRange  = 0 .. M ;                { 盤のレンジ                }
  23.          TableStatus = (Empty,Mine,Ground) ;   { 盤の状態 (空､地雷､陣地)   }
  24.          PrintMode   = (Normal,MinePrint)  ;   { 盤印字   (通常､地雷出力)  }
  25.  
  26.   var    Table       : array[TableRange,TableRange] of TableStatus ;  { 盤 }
  27.          RD          : integer ;    { 乱数発生で使用                       }
  28.          Remainder   : integer ;    { 残りの陣地数                         }
  29.  
  30. {*********************************}
  31. {* k未満の乱数を乗算合同法で発生 *}
  32. {*********************************}
  33.   function rand(k:integer): integer;
  34.     const MaxInteger = 32767 ;
  35.   begin
  36.     RD := RD * 259 ;
  37.     if RD > MaxInteger then  RD := RD mod MaxInteger ;
  38.     rand := RD mod k
  39.   end { rand };
  40.  
  41. {**************************}
  42. {*     初期設定           *}
  43. {**************************}
  44.   procedure Init ;
  45.     var x,y : TableRange ;
  46.         i   : integer    ;
  47.   begin
  48.     repeat
  49.       write('乱数の初期値を入れて下さい(0以外) ? ');
  50.       readln(RD)
  51.     until RD <> 0 ;                       { 0では計算できないので再入力 }
  52.  
  53.    for x:=0 to M do
  54.      for y := 0 to M do
  55.        Table[x,y] := Empty ;              { 全エリアを空に初期設定    }
  56.    for i := 1 to MaxMine do               { MaxMine分の地雷を埋め込む }
  57.    begin
  58.      repeat
  59.        x := rand(N)+1 ; y := rand(N)+1 ;  { 1～Nまでの乱数発生   }
  60.      until Table[x,y] = Empty ;           { 空でなければ繰り返す }
  61.      Table[x,y] := Mine                   { 地雷を埋め込む       }
  62.    end  ;
  63.    Remainder := sqr(N) - MaxMine          { 残り地雷数を初期設定 }
  64.   end { Init } ;
  65.  
  66. {**************************}
  67. {*        盤の印字        *}
  68. {**************************}
  69.   procedure Print(mode : PrintMode) ;
  70.     type line = packed array[1..4] of char ; { 長さ4の文字列 }
  71.     var  x,y        : TableRange ;
  72.          MineNumber : integer    ;           { 八方の地雷数  }
  73.  
  74.     {***** 横線の印字処理 *****}
  75.     procedure Hline(left,mid,right : line) ;
  76.       var y : TableRange ;
  77.     begin
  78.       write(left);
  79.       for y:=1 to N-1 do write(mid) ;
  80.       writeln(right)
  81.     end { Hline } ;
  82.  
  83.   begin { Print }
  84.     writeln ;
  85.     Hline('  ┏','━┳','━┓') ;            { 一番上の横線 }
  86.     for x:=1 to N do
  87.     begin
  88.       write('  ┃') ;
  89.       for y:=1 to N do
  90.       begin
  91.         case Table[x,y] of
  92.           Ground : begin                     { 陣地の時       }
  93.                      MineNumber :=           { 地雷数を求める }
  94.                        ord(Table[x-1,y-1]=Mine) + ord(Table[x-1,y  ]=Mine)
  95.                      + ord(Table[x-1,y+1]=Mine) + ord(Table[x  ,y-1]=Mine)
  96.                      + ord(Table[x  ,y+1]=Mine) + ord(Table[x+1,y-1]=Mine)
  97.                      + ord(Table[x+1,y  ]=Mine) + ord(Table[x+1,y+1]=Mine) ;
  98.                      write(chr(27),'[7m',MineNumber:2,chr(27),'[0m')
  99.                                              { リバースで地雷数を表示 }
  100.                    end ;
  101.           Empty  : write((x-1)*N+y-1:2) ;    { 空の時､座標を表示 }
  102.           Mine   : if mode=Normal then write((x-1)*N+y-1:2)  { 座標表示 }
  103.                                   else write('★')           { 地雷表示 }
  104.         end ;
  105.         write('┃')
  106.       end ;
  107.       writeln ;
  108.       if x <> N then Hline('  ┣','━╋','━┫')  { 中間の横線   }
  109.                 else Hline('  ┗','━┻','━┛')  { 一番下の横線 }
  110.     end ;
  111.     writeln('残り陣地は',Remainder:2)
  112.   end { Print } ;
  113.  
  114. {**********************}
  115. {*   陣地座標を入力   *}
  116. {**********************}
  117.   procedure InputPoint ;
  118.     var x,y : TableRange ;
  119.       point : integer    ;
  120.       ok    : Boolean    ;
  121.   begin
  122.     writeln ;
  123.     repeat
  124.       write('取る陣地を上の数字で入れて下さい ? ') ;
  125.       readln(point) ;
  126.       ok := (0 <= point) and (point < sqr(N)) ;
  127.       if ok then
  128.       begin
  129.         x := point div N + 1 ; y := point mod N + 1 ;   { 対応するx,y座標 }
  130.         if Table[x,y] = Mine then  { 地雷に当たった時 }
  131.         begin
  132.           writeln('地雷に当たりました！') ;
  133.           goto 999                 { ゲームオーバー }
  134.         end ;
  135.         ok := (Table[x,y] = Empty) { 空ならOK }
  136.       end
  137.     until ok ;                     { OKでない時はもう一度入力 }
  138.  
  139.     Table[x,y] := Ground ;         { 陣地を取った }
  140.     Remainder := Remainder - 1     { 残り陣地数   }
  141.   end { InputPoint } ;
  142.  
  143. {**********************}
  144. {*    メイン処理      *}
  145. {**********************}
  146. begin
  147.   Init                ;            { 初期設定   }
  148.   repeat
  149.     Print(Normal)     ;            { 盤を印字   }
  150.     InputPoint                     { 陣地を入力 }
  151.   until Remainder = 0 ;            { 残り陣地があれば繰り返す }
  152. 999 :                              { ゲームオーバー用のラベル }
  153.   Print(MinePrint)    ;            { 地雷場所を印字 }
  154.   if Remainder = 0 then writeln('**** クリア！ ****')
  155.                    else writeln('**** ゲームオーバー！****')
  156. end.
  157.